home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / raise.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  8.3 KB  |  300 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out Tk's "raise" and
  2. # "lower" commands, plus associated code to manage window
  3. # stacking order.  It is organized in the standard fashion
  4. # for Tcl tests.
  5. #
  6. # Copyright (c) 1993-1994 The Regents of the University of California.
  7. # Copyright (c) 1994 Sun Microsystems, Inc.
  8. #
  9. # See the file "license.terms" for information on usage and redistribution
  10. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  11. #
  12. # SCCS: @(#) raise.test 1.8 96/02/16 10:55:18
  13.  
  14. if {[info commands testmakeexist] == {}} {
  15.     puts "This application hasn't been compiled with the \"testmakeexist\""
  16.     puts "command, so I can't run this test.  Are you sure you're using"
  17.     puts "tktest instead of wish?"
  18.     return
  19. }
  20.  
  21. if {[string compare test [info procs test]] == 1} then \
  22.   {source defs}
  23.  
  24. # Procedure to create a bunch of overlapping windows, which should
  25. # make it easy to detect differences in order.
  26.  
  27. proc raise_setup {} {
  28.     foreach i [winfo child .raise] {
  29.     destroy $i
  30.     }
  31.     foreach i {a b c d e} {
  32.     label .raise.$i -text $i -relief raised -bd 2
  33.     }
  34.     place .raise.a -x 20 -y 60 -width 60 -height 80
  35.     place .raise.b -x 60 -y 60 -width 60 -height 80
  36.     place .raise.c -x 100 -y 60 -width 60 -height 80
  37.     place .raise.d -x 40 -y 20 -width 100 -height 60
  38.     place .raise.e -x 40 -y 120 -width 100 -height 60
  39. }
  40.  
  41. # Procedure to return information about which windows are on top
  42. # of which other windows.
  43.  
  44. proc raise_getOrder {} {
  45.     set x [winfo rootx .raise]
  46.     set y [winfo rooty .raise]
  47.     list [winfo name [winfo containing [expr $x+50] [expr $y+70]]] \
  48.         [winfo name [winfo containing [expr $x+90] [expr $y+70]]] \
  49.         [winfo name [winfo containing [expr $x+130] [expr $y+70]]] \
  50.         [winfo name [winfo containing [expr $x+70] [expr $y+100]]] \
  51.         [winfo name [winfo containing [expr $x+110] [expr $y+100]]] \
  52.         [winfo name [winfo containing [expr $x+50] [expr $y+130]]] \
  53.         [winfo name [winfo containing [expr $x+90] [expr $y+130]]] \
  54.         [winfo name [winfo containing [expr $x+130] [expr $y+130]]]
  55. }
  56.  
  57. # Procedure to set up a collection of top-level windows
  58.  
  59. proc raise_makeToplevels {} {
  60.     foreach i [winfo child .] {
  61.     destroy $i
  62.     }
  63.     foreach i {.raise1 .raise2 .raise3} {
  64.     toplevel $i
  65.     wm geom $i 150x100+0+0
  66.     update
  67.     }
  68. }
  69.  
  70. foreach i [winfo child .] {
  71.     destroy $i
  72. }
  73. toplevel .raise
  74. wm geom .raise 250x200+0+0
  75.  
  76. test raise-1.1 {preserve creation order} {
  77.     raise_setup
  78.     update
  79.     raise_getOrder
  80. } {d d d b c e e e}
  81. test raise-1.2 {preserve creation order} {
  82.     raise_setup
  83.     testmakeexist .raise.a
  84.     update
  85.     raise_getOrder
  86. } {d d d b c e e e}
  87. test raise-1.3 {preserve creation order} {
  88.     raise_setup
  89.     testmakeexist .raise.c
  90.     update
  91.     raise_getOrder
  92. } {d d d b c e e e}
  93. test raise-1.4 {preserve creation order} {
  94.     raise_setup
  95.     testmakeexist .raise.e
  96.     update
  97.     raise_getOrder
  98. } {d d d b c e e e}
  99. test raise-1.5 {preserve creation order} {
  100.     raise_setup
  101.     testmakeexist .raise.d .raise.c .raise.b
  102.     update
  103.     raise_getOrder
  104. } {d d d b c e e e}
  105.  
  106. test raise-2.1 {raise internal windows before creation} {
  107.     raise_setup
  108.     raise .raise.a
  109.     update
  110.     raise_getOrder
  111. } {a d d a c a e e}
  112. test raise-2.2 {raise internal windows before creation} {
  113.     raise_setup
  114.     raise .raise.c
  115.     update
  116.     raise_getOrder
  117. } {d d c b c e e c}
  118. test raise-2.3 {raise internal windows before creation} {
  119.     raise_setup
  120.     raise .raise.e
  121.     update
  122.     raise_getOrder
  123. } {d d d b c e e e}
  124. test raise-2.4 {raise internal windows before creation} {
  125.     raise_setup
  126.     raise .raise.e .raise.a
  127.     update
  128.     raise_getOrder
  129. } {d d d b c e b c}
  130. test raise-2.5 {raise internal windows before creation} {
  131.     raise_setup
  132.     raise .raise.a .raise.d
  133.     update
  134.     raise_getOrder
  135. } {a d d a c e e e}
  136.  
  137. test raise-3.1 {raise internal windows after creation} {
  138.     raise_setup
  139.     update
  140.     raise .raise.a .raise.d
  141.     raise_getOrder
  142. } {a d d a c e e e}
  143. test raise-3.2 {raise internal windows after creation} {
  144.     raise_setup
  145.     testmakeexist .raise.a .raise.b
  146.     raise .raise.a .raise.b
  147.     update
  148.     raise_getOrder
  149. } {d d d a c e e e}
  150. test raise-3.3 {raise internal windows after creation} {
  151.     raise_setup
  152.     testmakeexist .raise.a .raise.d
  153.     raise .raise.a .raise.b
  154.     update
  155.     raise_getOrder
  156. } {d d d a c e e e}
  157. test raise-3.4 {raise internal windows after creation} {
  158.     raise_setup
  159.     testmakeexist .raise.a .raise.c .raise.d
  160.     raise .raise.a .raise.b
  161.     update
  162.     raise_getOrder
  163. } {d d d a c e e e}
  164.  
  165. test raise-4.1 {raise relative to nephews} {
  166.     raise_setup
  167.     update
  168.     frame .raise.d.child
  169.     raise .raise.a .raise.d.child
  170.     raise_getOrder
  171. } {a d d a c e e e}
  172. test raise-4.2 {raise relative to nephews} {
  173.     raise_setup
  174.     update
  175.     frame .raise2
  176.     list [catch {raise .raise.a .raise2} msg] $msg
  177. } {1 {can't raise ".raise.a" above ".raise2"}}
  178. catch {destroy .raise2}
  179.  
  180. test raise-5.1 {lower internal windows} {
  181.     raise_setup
  182.     update
  183.     lower .raise.d
  184.     raise_getOrder
  185. } {a b c b c e e e}
  186. test raise-5.2 {lower internal windows} {
  187.     raise_setup
  188.     update
  189.     lower .raise.d .raise.b
  190.     raise_getOrder
  191. } {d b c b c e e e}
  192. test raise-5.3 {lower internal windows} {
  193.     raise_setup
  194.     update
  195.     lower .raise.a .raise.e
  196.     raise_getOrder
  197. } {a d d a c e e e}
  198. test raise-5.4 {lower internal windows} {
  199.     raise_setup
  200.     update
  201.     frame .raise2
  202.     list [catch {lower .raise.a .raise2} msg] $msg
  203. } {1 {can't lower ".raise.a" below ".raise2"}}
  204. catch {destroy .raise2}
  205.  
  206. test raise-6.1 {raise/lower toplevel windows} {nonPortable} {
  207.     raise_makeToplevels
  208.     update
  209.     raise .raise1
  210.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  211. } .raise1
  212. test raise-6.2 {raise/lower toplevel windows} {nonPortable} {
  213.     raise_makeToplevels
  214.     update
  215.     raise .raise2
  216.     winfo containing [winfo rootx .raise1] [winfo rooty .raise1]
  217. } .raise2
  218. test raise-6.3 {raise/lower toplevel windows} {nonPortable} {
  219.     raise_makeToplevels
  220.     update
  221.     raise .raise3
  222.     raise .raise2
  223.     raise .raise1 .raise3
  224.     set result [winfo containing [winfo rootx .raise1] \
  225.         [winfo rooty .raise1]]
  226.     destroy .raise2
  227.     update
  228.     after 500
  229.     list $result [winfo containing [winfo rootx .raise1] \
  230.         [winfo rooty .raise1]]
  231. } {.raise2 .raise1}
  232. test raise-6.4 {raise/lower toplevel windows} {nonPortable} {
  233.     raise_makeToplevels
  234.     update
  235.     raise .raise2
  236.     raise .raise1
  237.     lower .raise3 .raise1
  238.     set result [winfo containing [winfo rootx .raise1] \
  239.         [winfo rooty .raise1]]
  240.     wm geometry .raise2 +30+30
  241.     wm geometry .raise1 +60+60
  242.     destroy .raise1
  243.     update
  244.     after 500
  245.     list $result [winfo containing [winfo rootx .raise2] \
  246.         [winfo rooty .raise2]]
  247. } {.raise1 .raise3}
  248. test raise-6.5 {raise/lower toplevel windows} {nonPortable} {
  249.     raise_makeToplevels
  250.     raise .raise1
  251.     set time [lindex [time {raise .raise1}] 0]
  252.     expr {$time < 2000000}
  253. } 1
  254. test raise-6.6 {raise/lower toplevel windows} {nonPortable} {
  255.     raise_makeToplevels
  256.     update
  257.     raise .raise2
  258.     raise .raise1
  259.     raise .raise3
  260.     frame .raise1.f1
  261.     frame .raise1.f1.f2
  262.     lower .raise3 .raise1.f1.f2
  263.     set result [winfo containing [winfo rootx .raise1] \
  264.         [winfo rooty .raise1]]
  265.     destroy .raise1
  266.     update
  267.     after 500
  268.     list $result [winfo containing [winfo rootx .raise2] \
  269.         [winfo rooty .raise2]]
  270. } {.raise1 .raise3}
  271.  
  272. test raise-7.1 {errors in raise/lower commands} {
  273.     list [catch {raise} msg] $msg
  274. } {1 {wrong # args: should be "raise window ?aboveThis?"}}
  275. test raise-7.2 {errors in raise/lower commands} {
  276.     list [catch {raise a b c} msg] $msg
  277. } {1 {wrong # args: should be "raise window ?aboveThis?"}}
  278. test raise-7.3 {errors in raise/lower commands} {
  279.     list [catch {raise badName} msg] $msg
  280. } {1 {bad window path name "badName"}}
  281. test raise-7.4 {errors in raise/lower commands} {
  282.     list [catch {raise . badName2} msg] $msg
  283. } {1 {bad window path name "badName2"}}
  284. test raise-7.5 {errors in raise/lower commands} {
  285.     list [catch {lower} msg] $msg
  286. } {1 {wrong # args: should be "lower window ?belowThis?"}}
  287. test raise-7.6 {errors in raise/lower commands} {
  288.     list [catch {lower a b c} msg] $msg
  289. } {1 {wrong # args: should be "lower window ?belowThis?"}}
  290. test raise-7.7 {errors in raise/lower commands} {
  291.     list [catch {lower badName3} msg] $msg
  292. } {1 {bad window path name "badName3"}}
  293. test raise-7.8 {errors in raise/lower commands} {
  294.     list [catch {lower . badName4} msg] $msg
  295. } {1 {bad window path name "badName4"}}
  296.  
  297. foreach i [winfo child .] {
  298.     destroy $i
  299. }
  300.